00100	;-----------------------------------------------------------------
00200	INTERN OLD44,UNIVER,BLKCNT,AVAIL
00300		OLD44:	0
00400		UNIVER:	0
00500		BLKCNT: 0
00600		AVAIL:	0
00700		REMAINDER:0
00800		NODSIZ←←=12	;NUMBER OF WORDS PER NODE.
00900	SUBR(MORCOR)------------------------------------------------------
01000	BEGIN MORCOR; - GET MORE CORE - BGB - 4 DEC 1972.
01100	
01200	;INITIALIZE THE UNIVERSE NODE WHEN NECESSARY.
01300		SKIPE OLD44↔GO L1
01400		LAC 1,44↔DAC 1,OLD44
01500		ADDI 1,3↔DAC 1,BLKCNT
01550		ADDI 1,1↔DAC 1,AVAIL↔DAC 1,UNIVER
01800		SETZM REMAINDER
01900	
02000	;FOUR MORE K !
02100	L1:	LAC 1,44↔LAC 0,1↔ADDI 0,10000
02200		CALLI 11↔GO[FATAL(NO MORE CORE.)]
02300		AOS 1↔SUB 1,REMAINDER↔DAC 2,AC2#↔LAC 2,44
02400		SETZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
02500	
02600	;MAKE AVAIL LIST.
02700		ADDI 1,3↔DIP 1,1↔ADD 1,[XWD NODSIZ,0]
02800		SKIPE@BLKCNT↔GO .+3
02900		ADD 1,[XWD NODSIZ,NODSIZ]↔AOS@BLKCNT  ;STEP OVER THE UNIVERSE.
03000		DAPZ 1,@AVAIL
03100	L2:	HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
03200		CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L2
03300		SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
03400		LACI 10000↔LAC 1,UNIVER↔ADDM -3(1)
03500		LAC 1,@AVAIL
03600		LAC 2,AC2↔POP0J
03700	
03800	BEND;1/12/73------------------------------------------------------
     

00100	SUBR(MAKE)TYPE----------------------------------------------------
00200	BEGIN MAKE; ALLOCATE A BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
00300		SKIPN 1,@AVAIL↔CALL(MORCOR)
00400		CDR(1)↔DAP @AVAIL
00500		SETZM(1)↔AOS @BLKCNT
00600		POP P,.+3↔POP P,(1)↔GO @.+1↔0
00800	BEND;1/12/73------------------------------------------------------
00900	
01000	SUBR(KILL)NODE----------------------------------------------------
01100	BEGIN KILL; - RELEASE  BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
01200		LAC 1,ARG1
01300		SKIPN 2(1)↔GO[OUTSTR[ASCIZ/	AN EMPTY NODE KILLED.
01400	/]↔POP1J]↔SOS @BLKCNT
01500		LIPI -3(1)↔LAPI -2(1)↔SETZM -3(1)↔BLT 8(1)    ;CLEAR NODE.
01600		LAC @AVAIL↔DAPZ(1)↔DAPZ 1,@AVAIL
01700		POP1J
01800	BEND;1/12/73------------------------------------------------------
01900	
02000	SUBR(RINGIN)------------------------------------------------------
02100	BEGIN RINGIN;(PART,WHOLE) RING PART INTO A WHOLE -BGB- 6 DEC 1972.
02200		LAC 1,ARG2
02300		LAC 3,ARG1
02400	;	SON 2,3
02500	;	JUMPE 2,[SON. 1,3↔DIP 1,(1)↔DAP 1,(1)↔POP2J]
02600		CAR 3,(2)
02700		DIP 3,(1)↔DAP 1,(3)
02800		DAP 2,(1)↔DIP 1,(2)
02900		POP2J↔LIT
03000	BEND;1/10/73------------------------------------------------------